Collection of Tools & Utilities/Collection of Tools and Utilities.iso/pascal/psdsm103.zip/DOSMEM.PAS

Pascal/Delphi Source File | 1993-01-27 | 3KB | 190 lines

{

                                                      ╔══════════════════╗
                                                      ║  Big DOS Memory  ║
                                                      ║    Allocations   ║
                                                      ║    Rev. 1.03     ║
                                                      ╚══════════════════╝

}

{$F-} {$O-} {$A+} {$G-}
{$V-} {$B-} {$X-} {$N+} {$E+}

{$I FINAL.PAS}

{$DEFINE UsingGraph}

{$IFDEF FINAL}
  {$I-} {$R-}
  {$D-} {$L-} {$S-}
{$ENDIF}

Unit DosMem;

Interface

{$IFDEF UsingGraph}

Uses Graph;

{$ENDIF}

Procedure GetMem   (Var P:Pointer;Size:LongInt);
Procedure FreeMem  (Var P:Pointer;Size:LongInt);
Function  MaxAvail :LongInt;
Function  MemAvail :LongInt;
Procedure New;
Procedure Dispose;
Procedure Mark;
Procedure Release;

{$IFDEF UsingGraph}

Function  ImageSize(X1,Y1,X2,Y2:LongInt):LongInt;

{$ENDIF}

Implementation

Procedure GetMem(Var P:Pointer;Size:LongInt);

Var
  NewSize  :Word;
  DosSeg   :Word;

Begin
  NewSize:=(Size+15) Div 16;

  Asm
    mov  ah, 048h
    mov  bx, NewSize
    int  21h
    jnc  @NoErr
    xor  ax, ax         {Return 0 if Error}
    @NoErr:
    mov  DosSeg,ax
  End;

  P:=Ptr(DosSeg,0);

  {$IFDEF NOTFINAL}

  If DosSeg=0 Then              {No Memory Available}
  Repeat
    System.GetMem(P,65535);     {Generate Error 203, Heap Overflow}
  Until False;

  {$ENDIF}

End;

Procedure FreeMem(Var P:Pointer;Size:LongInt);

Var
  Segment  :Word;
  Error    :Boolean;

Begin
  {$IFDEF NOTFINAL}

  If Ofs(P^)<>0 Then
  Begin
    P:=NIL;
    System.FreeMem(P,1);     {Generate Error 204 as Pointer Offset is not 0}
  End;

  {$ENDIF}

  Segment:=Seg(P^);

  Asm
    mov  ax, Segment
    mov  es, ax                 {Set Segment}

    xor  al, al
    mov  Error, al              {Assume No Error, Error = False}

    mov  ah, 049h
    int  21h
    jnc  @NoErr
    mov  Error, True            {No Zero Value into Segment, Error Occurred}
    @NoErr:
  End;

  If Not Error Then
    P:=NIL;                     {P is NIL if No Error, Else No Change}
End;

Function MaxAvail:LongInt;

Var
  NewSize  :Word;

Begin
  Asm
    mov  ah, 048h
    mov  bx, 0FFFFh
    int  21h
    mov  NewSize, bx
  End;
  MaxAvail:=LongInt(NewSize)*16;
End;

Function MemAvail:LongInt;
Begin
  MemAvail:=MaxAvail;
End;

Procedure New;
Begin
  WriteLn('Not Available, Use GetMem or FreeMem.');
  Halt;
End;

Procedure Dispose;
Begin
  WriteLn('Not Available, Use GetMem or FreeMem.');
  Halt;
End;

Procedure Mark;
Begin
  WriteLn('Not Available, Use GetMem or FreeMem.');
  Halt;
End;

Procedure Release;
Begin
  WriteLn('Not Available, Use GetMem or FreeMem.');
  Halt;
End;

{$IFDEF UsingGraph}

Function ImageSize(X1,Y1,X2,Y2:LongInt):LongInt;

Var
  XSize,
  YSize :Word;

Begin
  XSize:=X2-X1+1;
  YSize:=Y2-Y1+1;
  Case GetMaxColor Of
       15:ImageSize:=(((XSize) shr 1) + 1) * YSize + 4;
      255:ImageSize:=XSize * YSize + 4;
    32767,
    65535:ImageSize:=2 * XSize * YSize + 4;
    {16.7 Million - in a Word - Now What?}
  Else
    ImageSize:=Graph.ImageSize(X1,Y1,X2,Y2);
  End;
End;

{$ENDIF}

End.

{ Copyright 1993, Michael Gallias }